home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / runtime / io.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-24  |  8.1 KB  |  373 lines  |  [TEXT/MPS ]

  1. /* Buffered input/output. */
  2.  
  3. #include <fcntl.h>
  4. #ifdef __TURBOC__
  5. #include <io.h>
  6. #endif
  7. #include "alloc.h"
  8. #include "fail.h"
  9. #include "io.h"
  10. #include "memory.h"
  11. #include "misc.h"
  12. #include "mlvalues.h"
  13. #include "signals.h"
  14. #include "sys.h"
  15.  
  16. /* Common functions. */
  17.  
  18. struct channel * open_descriptor(fd)       /* ML */
  19.      value fd;
  20. {
  21.   struct channel * channel;
  22.  
  23.   channel = (struct channel *) stat_alloc(sizeof(struct channel));
  24.   channel->fd = Long_val(fd);
  25.   channel->offset = 0;
  26.   channel->curr = channel->max = channel->buff;
  27.   channel->end = channel->buff + IO_BUFFER_SIZE;
  28.   return channel;
  29. }
  30.  
  31. value channel_descriptor(channel)   /* ML */
  32.      struct channel * channel;
  33. {
  34.   return Val_long(channel->fd);
  35. }
  36.  
  37. value channel_size(channel)      /* ML */
  38.      struct channel * channel;
  39. {
  40.   long end;
  41.  
  42.   end = lseek(channel->fd, 0, 2);
  43.   if (end == -1) sys_error();
  44.   if (lseek(channel->fd, channel->offset, 0) != channel->offset) sys_error();
  45.   return Val_long(end);
  46. }
  47.  
  48. /* Output */
  49.  
  50. static void really_write(fd, p, n)
  51.      int fd;
  52.      char * p;
  53.      int n;
  54. {
  55.   int retcode;
  56.   while (n > 0) {
  57.     retcode = write(fd, p, n);
  58.     if (retcode == -1) sys_error();
  59.     p += retcode;
  60.     n -= retcode;
  61.   }
  62. }   
  63.  
  64. value flush(channel)            /* ML */
  65.      struct channel * channel;
  66. {
  67.   int n;
  68.   n = channel->max - channel->buff;
  69.   if (n > 0) {
  70.     really_write(channel->fd, channel->buff, n);
  71.     channel->offset += n;
  72.     channel->curr = channel->buff;
  73.     channel->max  = channel->buff;
  74.   }
  75.   return Atom(0);
  76. }
  77.  
  78. value output_char(channel, ch)  /* ML */
  79.      struct channel * channel;
  80.      value ch;
  81. {
  82.   putch(channel, Long_val(ch));
  83.   return Atom(0);
  84. }
  85.  
  86. void putword(channel, w)
  87.      struct channel * channel;
  88.      long w;
  89. {
  90.   putch(channel, w >> 24);
  91.   putch(channel, w >> 16);
  92.   putch(channel, w >> 8);
  93.   putch(channel, w);
  94. }
  95.  
  96. value output_int(channel, w)    /* ML */
  97.      struct channel * channel;
  98.      value w;
  99. {
  100.   putword(channel, Long_val(w));
  101.   return Atom(0);
  102. }
  103.  
  104. void putblock(channel, p, n)
  105.      struct channel * channel;
  106.      char * p;
  107.      unsigned n;
  108. {
  109.   unsigned m;
  110.  
  111.   m = channel->end - channel->curr;
  112.   if (channel->curr == channel->buff && n >= m) {
  113.     really_write(channel->fd, p, n);
  114.     channel->offset += n;
  115.   } else if (n <= m) {
  116.     bcopy(p, channel->curr, n);
  117.     channel->curr += n;
  118.     if (channel->curr > channel->max) channel->max = channel->curr;
  119.   } else {
  120.     bcopy(p, channel->curr, m);
  121.     p += m;
  122.     n -= m;
  123.     m = channel->end - channel->buff;
  124.     really_write(channel->fd, channel->buff, m);
  125.     channel->offset += m;
  126.     if (n <= m) {
  127.       bcopy(p, channel->buff, n);
  128.       channel->curr = channel->max = channel->buff + n;
  129.     } else {
  130.       really_write(channel->fd, p, n);
  131.       channel->offset += n;
  132.       channel->curr = channel->max = channel->buff;
  133.     }
  134.   }
  135. }
  136.  
  137. value output(channel, buff, start, length) /* ML */
  138.      value channel, buff, start, length;
  139. {
  140.   putblock((struct channel *) channel,
  141.            &Byte(buff, Long_val(start)),
  142.            (unsigned) Long_val(length));
  143.   return Atom(0);
  144. }
  145.  
  146. value seek_out(channel, pos)    /* ML */
  147.      struct channel * channel;
  148.      value pos;
  149. {
  150.   long dest;
  151.  
  152.   dest = Long_val(pos);
  153.   if (dest >= channel->offset &&
  154.       dest <= channel->offset + channel->max - channel->buff) {
  155.     channel->curr = channel->buff + dest - channel->offset;
  156.   } else {
  157.     flush(channel);
  158.     if (lseek(channel->fd, dest, 0) != dest) sys_error();
  159.     channel->offset = dest;
  160.   }
  161.   return Atom(0);
  162. }
  163.  
  164. value pos_out(channel)          /* ML */
  165.      struct channel * channel;
  166. {
  167.   return Val_long(channel->offset + channel->curr - channel->buff);
  168. }
  169.  
  170. value close_out(channel)     /* ML */
  171.      struct channel * channel;
  172. {
  173.   flush(channel);
  174.   close(channel->fd);
  175.   stat_free((char *) channel);
  176.   return Atom(0);
  177. }
  178.  
  179. /* Input */
  180.  
  181. static int really_read(fd, p, n)
  182.      int fd;
  183.      char * p;
  184.      unsigned n;
  185. {
  186.   int retcode;
  187.  
  188.   enter_blocking_section();
  189. #ifdef MSDOS
  190.   retcode = msdos_read(fd, p, n);
  191. #else
  192.   retcode = read(fd, p, n);
  193. #endif
  194.   leave_blocking_section();
  195.   if (retcode == -1) sys_error();
  196.   return retcode;
  197. }
  198.  
  199. unsigned char refill(channel)
  200.      struct channel * channel;
  201. {
  202.   int n;
  203.  
  204.   n = really_read(channel->fd, channel->buff, IO_BUFFER_SIZE);
  205.   if (n == 0) mlraise(Atom(END_OF_FILE_EXN));
  206.   channel->offset += n;
  207.   channel->max = channel->buff + n;
  208.   channel->curr = channel->buff + 1;
  209.   return (unsigned char)(channel->buff[0]);
  210. }
  211.  
  212. value input_char(channel)       /* ML */
  213.      struct channel * channel;
  214. {
  215.   unsigned char c;
  216.   c = getch(channel);
  217.   return Val_long(c);
  218. }
  219.  
  220. long getword(channel)
  221.      struct channel * channel;
  222. {
  223.   int i;
  224.   long res;
  225.  
  226.   res = 0;
  227.   for(i = 0; i < 4; i++) {
  228.     res = (res << 8) + getch(channel);
  229.   }
  230.   return res;
  231. }
  232.  
  233. value input_int(channel)        /* ML */
  234.      struct channel * channel;
  235. {
  236.   return Val_long(getword(channel));
  237. }
  238.  
  239. unsigned getblock(channel, p, n)
  240.      struct channel * channel;
  241.      char * p;
  242.      unsigned n;
  243. {
  244.   unsigned m, l;
  245.  
  246.   m = channel->max - channel->curr;
  247.   if (n <= m) {
  248.     bcopy(channel->curr, p, n);
  249.     channel->curr += n;
  250.     return n;
  251.   } else if (m > 0) {
  252.     bcopy(channel->curr, p, m);
  253.     channel->curr += m;
  254.     return m;
  255.   } else if (n < IO_BUFFER_SIZE) {
  256.     l = really_read(channel->fd, channel->buff, IO_BUFFER_SIZE);
  257.     channel->offset += l;
  258.     channel->max = channel->buff + l;
  259.     if (n > l) n = l;
  260.     bcopy(channel->buff, p, n);
  261.     channel->curr = channel->buff + n;
  262.     return n;
  263.   } else {
  264.     l = really_read(channel->fd, p, n);
  265.     channel->offset += l;
  266.     return l;
  267.   }
  268. }
  269.  
  270.  
  271. value input(channel, buff, start, length) /* ML */
  272.      value channel, buff, start, length;
  273. {
  274.   return Val_long(getblock((struct channel *) channel,
  275.                            &Byte(buff, Long_val(start)),
  276.                            (unsigned) Long_val(length)));
  277. }
  278.  
  279. value seek_in(channel, pos)     /* ML */
  280.      struct channel * channel;
  281.      value pos;
  282. {
  283.   long dest;
  284.  
  285.   dest = Long_val(pos);
  286.   if (dest >= channel->offset - (channel->max - channel->buff) &&
  287.       dest <= channel->offset) {
  288.     channel->curr = channel->max - (channel->offset - dest);
  289.   } else {
  290.     if (lseek(channel->fd, dest, 0) != dest) sys_error();
  291.     channel->offset = dest;
  292.     channel->curr = channel->max = channel->buff;
  293.   }
  294.   return Atom(0);
  295. }
  296.  
  297. value pos_in(channel)           /* ML */
  298.      struct channel * channel;
  299. {
  300.   return Val_long(channel->offset - (channel->max - channel->curr));
  301. }
  302.  
  303. value close_in(channel)     /* ML */
  304.      struct channel * channel;
  305. {
  306.   close(channel->fd);
  307.   stat_free((char *) channel);
  308.   return Atom(0);
  309. }
  310.  
  311. static value build_string(pref, start, end)
  312.      value pref;
  313.      char * start, * end;
  314. {
  315.   value res;
  316.   mlsize_t preflen;
  317.  
  318.   if (Is_block(pref)) {
  319.     Push_roots(r, 1);
  320.     r[0] = pref;
  321.     preflen = string_length(pref);
  322.     res = alloc_string(preflen + end - start);
  323.     bcopy(&Byte(r[0], 0), &Byte(res, 0), preflen);
  324.     bcopy(start, &Byte(res, preflen), end - start);
  325.     Pop_roots();
  326.   } else {
  327.     res = alloc_string(end - start);
  328.     bcopy(start, &Byte(res, 0), end - start);
  329.     return res;
  330.   }
  331.   return res;
  332. }
  333.  
  334. value input_line(channel)       /* ML */
  335.      struct channel * channel;
  336. {
  337.   char * start;
  338.   int n;
  339.   value res;
  340.  
  341.   Push_roots(r, 1);
  342. #define prevstring r[0]
  343.   prevstring = Val_long(0);
  344.   start = channel->curr;
  345.   do {
  346.     if (channel->curr >= channel->max) { /* No more characters available */
  347.       if (start > channel->buff) {       /* First, make as much room */
  348.         bcopy(start, channel->buff, channel->max - start); /* as possible */
  349.         n = start - channel->buff;       /* in the buffer */
  350.         channel->curr -= n;
  351.         channel->max  -= n;
  352.         start = channel->buff;
  353.       }
  354.       if (channel->curr >= channel->end) { /* Buffer full? */
  355.         prevstring = build_string(prevstring, start, channel->curr);
  356.         start = channel->buff;             /* Flush it in the heap */
  357.         channel->curr = channel->buff;
  358.       }
  359.       n = really_read(channel->fd, channel->curr, channel->end-channel->curr);
  360.       if (n == 0) {
  361.         Pop_roots();
  362.         mlraise(Atom(END_OF_FILE_EXN));
  363.       }
  364.       channel->offset += n;
  365.       channel->max = channel->curr + n;
  366.     }
  367.   } while (*(channel->curr)++ != '\n');
  368.   res = build_string(prevstring, start, channel->curr - 1);
  369.   Pop_roots();
  370.   return res;
  371. #undef prevstring
  372. }
  373.